home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / prodpack.zip / DB4PPSRC.EXE / _MAKEEXT.PRG < prev    next >
Text File  |  1993-05-04  |  5KB  |  149 lines
  1. FUNCTION _MakeExte
  2. PARAMETER pc_fname
  3. *--------------------------------------------------------------------
  4. * NAME
  5. *   _MAKEEXTE - Creates a dBASE IV structure extended
  6. *               file.
  7. *
  8. * SYNOPSIS
  9. *   _MAKEEXTE( pc_fname )
  10. *
  11. * DESCRIPTION
  12. *   The _MAKEEXTE() function creates an empty dBASE IV
  13. *   structure extended file.  It uses low-level file
  14. *   I/O functions to write the structure directly to
  15. *   disk.  This file can then be used to create
  16. *   other database files.
  17. *
  18. *   _MAKEEXTE() will return .T. if the filename was
  19. *   created, otherwise .F.  If no file extension is
  20. *   specified, ".DBF" is assumed.
  21. *
  22. *   Be warned that if a file with the same name
  23. *   already exists, it will be automatically
  24. *   overwritten.
  25. *
  26. * PARAMETER
  27. *   pc_fname - the name of the new structure extended
  28. *              file to create.
  29. *
  30. * EXAMPLE
  31. *
  32. *   * Create a new .DBF with a single field:
  33. *   IF _MAKEEXTE( "custtemp" )
  34. *     USE custtemp
  35. *     APPEND BLANK
  36. *     REPLACE field_name WITH "LAST_NAME",;
  37. *             field_type WITH "C",;
  38. *             field_len  WITH 30,;
  39. *             field_idx  WITH "Y"
  40. *     CREATE newdbf FROM custtemp
  41. *   ELSE
  42. *     ? "Error: Custtemp.dbf not created"
  43. *   ENDIF
  44. *
  45. * DEPENDENCIES
  46. *   _MAKEEXTE() uses the _FWRITE0 function.
  47. *
  48. * LIMITATIONS
  49. *   _MAKEEXTE() expects that TALK is OFF
  50. *
  51. * SEE ALSO:
  52. *   COPY STRUCTURE EXTENDED
  53. *
  54. *--------------------------------------------------------------------
  55.  
  56.   PRIVATE lc_newdbf, lh_newdbf, ll_result, ln_bytes
  57.  
  58.   ll_result = .F.
  59.   lc_newdbf = LTRIM( RTRIM( pc_fname ) )
  60.  
  61.   IF TYPE('lc_newdbf') = "C" .AND. ( .NOT. ISBLANK( lc_newdbf ) )
  62.  
  63.     lc_newdbf = IIF( .NOT. "." $ lc_newdbf, lc_newdbf, ;
  64.                      SUBSTR(lc_newdbf, 1, AT(".", lc_newdbf) - 1)) + ".DBF"
  65.     lh_newdbf = 0
  66.     IF DISKSPACE() < 5000
  67.       DEACTIVATE WINDOW _plswait        && Deactivate _PlsWait window
  68.       DO _Err_Box WITH [Insufficient disk space]
  69.       IF LASTKEY() = 28
  70.         DO _Helpsys WITH "_FXZERR", "NODISK"
  71.       ENDIF
  72.     ELSE
  73.       lh_newdbf = FCREATE( lc_newdbf, "rw" )
  74.     ENDIF
  75.     IF lh_newdbf > 0
  76.  
  77.       *-- .dbf with no memos
  78.       ln_bytes = FWRITE( lh_newdbf, CHR(3) )
  79.  
  80.       *-- date of last update
  81.       ln_bytes = FWRITE( lh_newdbf, ;
  82.         CHR( YEAR( DATE() ) - 1900 ) + CHR( MONTH( DATE() ) )+;
  83.         CHR( DAY( DATE() ) ) )
  84.  
  85.       *-- No records yet
  86.       ln_bytes = _FWRITE0( lh_newdbf, 4 )
  87.  
  88.       *-- Number of bytes in header.
  89.       ln_bytes = FWRITE( lh_newdbf, CHR(193) )
  90.       ln_bytes = FWRITE( lh_newdbf, CHR(0) )
  91.  
  92.       *-- Number off bytes in each records
  93.       ln_bytes = FWRITE( lh_newdbf, CHR(19) )
  94.       ln_bytes = FWRITE( lh_newdbf, CHR(0) )
  95.  
  96.       *-- Fill other dbf header stuff
  97.       ln_bytes = _FWRITE0( lh_newdbf, 20 )
  98.  
  99.       *-- Write out the extended structure.
  100.       ln_bytes = FWRITE( lh_newdbf, "FIELD_NAME" )
  101.       ln_bytes = FWRITE( lh_newdbf, CHR(0) )
  102.       ln_bytes = FWRITE( lh_newdbf, "C" )
  103.       ln_bytes = _FWRITE0( lh_newdbf, 4 )
  104.       ln_bytes = FWRITE( lh_newdbf, CHR(10) )
  105.       ln_bytes = _FWRITE0( lh_newdbf, 15 )
  106.  
  107.       ln_bytes = FWRITE( lh_newdbf, "FIELD_TYPE" )
  108.       ln_bytes = FWRITE( lh_newdbf, CHR(0) )
  109.       ln_bytes = FWRITE( lh_newdbf, "C" )
  110.       ln_bytes = _FWRITE0( lh_newdbf, 4 )
  111.       ln_bytes = FWRITE( lh_newdbf, CHR(1) )
  112.       ln_bytes = _FWRITE0( lh_newdbf, 15 )
  113.  
  114.       ln_bytes = FWRITE( lh_newdbf, "FIELD_LEN" )
  115.       ln_bytes = _FWRITE0( lh_newdbf, 2 )
  116.       ln_bytes = FWRITE( lh_newdbf, "N" )
  117.       ln_bytes = _FWRITE0( lh_newdbf, 4 )
  118.       ln_bytes = FWRITE( lh_newdbf, CHR(3) )
  119.       ln_bytes = _FWRITE0( lh_newdbf, 15 )
  120.  
  121.       ln_bytes = FWRITE( lh_newdbf, "FIELD_DEC" )
  122.       ln_bytes = _FWRITE0( lh_newdbf, 2 )
  123.       ln_bytes = FWRITE( lh_newdbf, "N" )
  124.       ln_bytes = _FWRITE0( lh_newdbf, 4 )
  125.       ln_bytes = FWRITE( lh_newdbf, CHR(3) )
  126.       ln_bytes = _FWRITE0( lh_newdbf, 15 )
  127.  
  128.       ln_bytes = FWRITE( lh_newdbf, "FIELD_IDX" )
  129.       ln_bytes = _FWRITE0( lh_newdbf, 2 )
  130.       ln_bytes = FWRITE( lh_newdbf, "C" )
  131.       ln_bytes = _FWRITE0( lh_newdbf, 4 )
  132.       ln_bytes = FWRITE( lh_newdbf, CHR(1) )
  133.       ln_bytes = _FWRITE0( lh_newdbf, 15 )
  134.  
  135.       *-- Write the field (header) terminator
  136.       ln_bytes = FWRITE( lh_newdbf, CHR(13) )
  137.  
  138.       IF FCLOSE( lh_newdbf )
  139.         ll_result = .T.
  140.       ENDIF
  141.  
  142.     ENDIF   && Could not create DBF skeleton
  143.  
  144.   ENDIF   && Parameters not correct
  145.  
  146. RETURN( ll_result )
  147. *-- EOF: _MakeExte( pc_fname )
  148.  
  149.